home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Draw.cls < prev    next >
Text File  |  1997-06-14  |  8KB  |  235 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "GDraw"
  6. Attribute VB_GlobalNameSpace = True
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorDraw
  13.     eeBaseDraw = 13460  ' Draw
  14. End Enum
  15.  
  16. Const PI = 3.1415
  17.  
  18. Sub BmpSpiral(cvsDst As Object, picSrc As Picture)
  19. With cvsDst
  20.     ' Calculate sizes
  21.     Dim dxSrc As Long, dySrc As Long, dxDst As Long, dyDst As Long
  22.     dxSrc = .ScaleX(picSrc.Width): dySrc = .ScaleY(picSrc.Height)
  23.     dxDst = .ScaleWidth: dyDst = .ScaleHeight
  24.     ' Set defaults (play with these numbers for different effects)
  25.     Dim xInc As Long, yInc As Long, xSize As Long, ySize As Long
  26.     Dim x As Long, y As Long
  27.     xInc = CInt(dxSrc * 0.01): yInc = CInt(dySrc * 0.01)
  28.     xSize = CInt(dxSrc * 0.1): ySize = CInt(dySrc * 0.1)
  29.     Dim radCur As Single, degCur As Integer, angInc As Integer
  30.     degCur = 0: angInc = 55
  31.     ' Start in center
  32.     x = (dxDst \ 2) - (dxSrc \ 2): y = (dyDst \ 2) - (dySrc \ 2)
  33.     
  34.     ' Spiral until off destination
  35.     Do
  36.         ' Draw at current position
  37.         .PaintPicture picSrc, x, y, , , , , , , vbSrcAnd
  38.         ' Calculate angle in radians
  39.         radCur = (degCur - 90) * (PI / 180)
  40.         ' Calculate next x and y
  41.         x = x + (xSize * Cos(radCur))
  42.         y = y + (ySize * Sin(radCur))
  43.         ' Widen spiral
  44.         xSize = xSize + xInc: ySize = ySize + yInc + 1
  45.         ' Turn angle
  46.         degCur = (degCur + angInc) Mod 360
  47.     Loop While (x > 0) And (x + dxSrc < dxDst - dxSrc) And _
  48.                (y > 0) And (y + dySrc < dyDst)
  49. End With
  50. End Sub
  51.  
  52. Sub SpiralBmp(cvsDst As Object, picSrc As Picture, _
  53.               ByVal xOff As Long, ByVal yOff As Long)
  54. With cvsDst
  55.     Dim xLeft As Long, xRight As Long, yTop As Long, yBottom As Long
  56.     Dim dxSrc As Long, dySrc As Long, xSrc As Long, ySrc As Long
  57.     Dim xDst As Long, yDst As Long, xInc As Long, yInc As Long
  58.     Dim x As Long, y As Long
  59.     ' Initialize
  60.     dxSrc = .ScaleX(picSrc.Width): dySrc = .ScaleY(picSrc.Height)
  61.     xInc = dxSrc / 20: yInc = dySrc / 20
  62.     xLeft = 0: yTop = 0:
  63.     xRight = dxSrc - xInc: yBottom = dySrc - yInc
  64.  
  65.     ' Draw each side
  66.     Do While (xLeft <= xRight) And (yTop <= yBottom)
  67.         ' Top
  68.         For x = xLeft To xRight Step xInc
  69.             .PaintPicture picSrc, x + xOff, y + yOff, xInc, yInc, _
  70.                 x, y, xInc, yInc, vbSrcCopy
  71.         Next
  72.         x = x - xInc: yTop = yTop + yInc
  73.         ' Right
  74.         For y = yTop To yBottom Step yInc
  75.             .PaintPicture picSrc, x + xOff, y + yOff, xInc, yInc, _
  76.                 x, y, xInc, yInc, vbSrcCopy
  77.         Next
  78.         y = y - yInc: xRight = x - xInc
  79.         ' Bottom
  80.         For x = xRight To xLeft Step -xInc
  81.             .PaintPicture picSrc, x + xOff, y + yOff, xInc, yInc, _
  82.                 x, y, xInc, yInc, vbSrcCopy
  83.         Next
  84.         x = x + xInc: yBottom = y - yInc
  85.         ' Left
  86.         For y = yBottom To yTop Step -yInc
  87.             .PaintPicture picSrc, x + xOff, y + yOff, xInc, yInc, _
  88.                 x, y, xInc, yInc, vbSrcCopy
  89.         Next
  90.         y = y + yInc: xLeft = xLeft + xInc
  91.     Loop
  92. End With
  93. End Sub
  94.  
  95. Sub BmpTile(cvsDst As Object, picSrc As Picture)
  96. With cvsDst
  97.     ' Calculate sizes
  98.     Dim dxSrc As Long, dySrc As Long, dxDst As Long, dyDst As Long
  99.     dxSrc = .ScaleX(picSrc.Width): dySrc = .ScaleY(picSrc.Height)
  100.     dxDst = .ScaleWidth: dyDst = .ScaleHeight
  101.     ' Tile until off destination
  102.     Dim x As Long, y As Long, fAutoRedraw As Boolean
  103.     fAutoRedraw = .AutoRedraw
  104.     .AutoRedraw = False
  105.     Do While y < dyDst
  106.         Do While x < dxDst
  107.             ' Draw at current position
  108.             .PaintPicture picSrc, x, y
  109.             x = x + dxSrc
  110.         Loop
  111.         y = y + dySrc
  112.         x = 0
  113.     Loop
  114.     .AutoRedraw = fAutoRedraw
  115. End With
  116. End Sub
  117.  
  118. Sub Star(cvsDst As Object, ByVal x As Long, ByVal y As Long, _
  119.          ByVal dxyRadius As Long, clrBorder As Long, _
  120.          Optional clrOut As Long = -1, Optional clrIn As Long = -1)
  121. With cvsDst
  122.     ' Handle optional arguments
  123.     If clrOut = -1 Then clrOut = clrBorder
  124.     If clrIn = -1 Then clrIn = clrOut
  125.     
  126.     ' Start is 144 degrees (converted to radians)
  127.     Const radStar As Double = 144 * PI / 180
  128.     
  129.     ' Calculate each point
  130.     Dim ptPoly(1 To 10) As Long, i As Integer
  131.     For i = 1 To 10 Step 2
  132.         ptPoly(i) = x + (Cos((i \ 2 + 1) * radStar) * dxyRadius)
  133.         ptPoly(i + 1) = y + (Sin((i \ 2 + 1) * radStar) * dxyRadius)
  134.     Next
  135.     
  136.     ' Set colors and style for star
  137.     .ForeColor = clrBorder    ' SetTextColor
  138.     .FillColor = clrOut       ' CreateSolidBrush
  139.     .FillStyle = vbSolid      ' More CreateSolidBrush
  140.     
  141.     Call MGDITool.VBPolygon(.hDC, ptPoly)
  142.     
  143.     ' Set color for center
  144.     .FillColor = clrIn        ' CreateSolidBrush
  145.     Call MGDITool.VBFloodFill(.hDC, x, y, .ForeColor)
  146. End With
  147. End Sub
  148.  
  149. Sub Fade(cvsDst As Object, _
  150.          Optional Red As Boolean = False, _
  151.          Optional Green As Boolean = False, _
  152.          Optional Blue As Boolean = True, _
  153.          Optional Vertical As Boolean = True, _
  154.          Optional Horizontal As Boolean = False, _
  155.          Optional LightToDark As Boolean = True)
  156. With cvsDst
  157.     ' Trap errors
  158.     On Error Resume Next
  159.     
  160.     ' Save properties
  161.     Dim fAutoRedraw As Boolean, ordDrawStyle As Integer
  162.     Dim ordDrawMode As Integer, iDrawWidth As Integer
  163.     Dim ordScaleMode As Integer
  164.     Dim rScaleWidth As Single, rScaleHeight As Single
  165.     fAutoRedraw = .AutoRedraw: iDrawWidth = .DrawWidth
  166.     ordDrawStyle = .DrawStyle: ordDrawMode = .DrawMode
  167.     rScaleWidth = .ScaleWidth: rScaleHeight = .ScaleHeight
  168.     ordScaleMode = .ScaleMode
  169.     ' Err set if object lacks one of previous properties
  170.     If Err Then Exit Sub
  171.     ' If you get here, object is OK (Printer lacks AutoRedraw)
  172.     fAutoRedraw = .AutoRedraw
  173.     
  174.     ' Set properties required for fade
  175.     .AutoRedraw = True
  176.     .DrawWidth = 3              ' Must be greater than 1 for dithering
  177.     .DrawStyle = vbInsideSolid  ' vbInvisible gives an interesting effect
  178.     .DrawMode = vbCopyPen       ' Try vbXorPen or vbMaskNotPen
  179.     .ScaleMode = vbPixels
  180.     .ScaleWidth = 256 * 2: .ScaleHeight = 256 * 2
  181.     
  182.     Dim clr As Long, i As Integer, x As Integer, y As Integer
  183.     Dim iRed As Integer, iGreen As Integer, iBlue As Integer
  184.     For i = 0 To 255
  185.         ' Set line color
  186.         If LightToDark Then
  187.             If Red Then iRed = 255 - i
  188.             If Blue Then iBlue = 255 - i
  189.             If Green Then iGreen = 255 - i
  190.         Else
  191.             If Red Then iRed = i
  192.             If Blue Then iBlue = i
  193.             If Green Then iGreen = i
  194.         End If
  195.         clr = RGB(iRed, iGreen, iBlue)
  196.         ' Draw each line of fade
  197.         If Vertical Then
  198.             cvsDst.Line (0, y)-(.ScaleWidth, y + 2), clr, BF
  199.             y = y + 2
  200.         End If
  201.         If Horizontal Then
  202.             cvsDst.Line (x, 0)-(x + 2, .ScaleHeight), clr, BF
  203.             x = x + 2
  204.         End If
  205.     Next
  206.     ' Put things back the way you found them
  207.     .AutoRedraw = fAutoRedraw: .DrawWidth = iDrawWidth
  208.     .DrawStyle = ordDrawStyle: .DrawMode = ordDrawMode
  209.     .ScaleMode = ordScaleMode
  210.     .ScaleWidth = rScaleWidth: .ScaleHeight = rScaleHeight
  211. End With
  212. End Sub
  213. '
  214.  
  215. #If fComponent = 0 Then
  216. Private Sub ErrRaise(e As Long)
  217.     Dim sText As String, sSource As String
  218.     If e > 1000 Then
  219.         sSource = App.ExeName & ".Draw"
  220.         Select Case e
  221.         Case eeBaseDraw
  222.             BugAssert True
  223.        ' Case ee...
  224.        '     Add additional errors
  225.         End Select
  226.         Err.Raise COMError(e), sSource, sText
  227.     Else
  228.         ' Raise standard Visual Basic error
  229.         sSource = App.ExeName & ".VBError"
  230.         Err.Raise e, sSource
  231.     End If
  232. End Sub
  233. #End If
  234.  
  235.